﻿module Main where

import Engine

import qualified Codec.Archive.Zip as Z
import Data.IORef
import System.IO
import System.Directory

import Data.Int
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Read as T
import qualified Data.Text.IO as T
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Encoding as LT

import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LB
import qualified Data.Map as Map

import Graphics.UI.Gtk
import Graphics.UI.Gtk.Glade

import Control.DeepSeq

instance (NFData k, NFData a) => NFData (Map.Map k a) where
    rnf = rnf . Map.toList 

instance NFData T.Text           

type RefDict = IORef WordDict

createDict :: String -> IO (IORef WordDict)
createDict dict_name = do
    str <- B.readFile dict_name
    let entries = parseToEntries $ T.lines $ T.decodeUtf8 str
        dict = Map.fromList entries
    deepseq dict (newIORef dict)
    
writeDict :: IORef WordDict -> String -> IO()
writeDict rdict dict_name = do
    dict <- readIORef rdict
    let text = dictToText dict
    LB.writeFile dict_name $ LT.encodeUtf8 text
    
unzipDict :: String -> IO ()    
unzipDict zip_name = do 
    dictZipFile <- LB.readFile zip_name
    Z.extractFilesFromArchive [] $ Z.toArchive dictZipFile     

zipDict :: String -> IO ()    
zipDict zip_name = do 
    let archive = Z.emptyArchive
    za <- Z.addFilesToArchive [] archive [zip_name]
    LB.writeFile "data.db" (Z.fromArchive za)
    
main :: IO ()
main = do

    currFileName <- newIORef ""
    
    unzipDict "data.db"    

    dict <- createDict "dict.txt"
       
    initGUI      
    
    builder <- builderNew
    builderAddFromFile builder "poet_ui.glade"

    window <- builderGetObject builder castToWindow "mainwindow"
    onDestroy window mainQuit

    wordDlg <- builderGetObject builder castToDialog "dictEditDialog"
    wordDlgWordEntry <- builderGetObject builder castToEntry "wordEntry"
    wordDlgAccentEntry <- builderGetObject builder castToEntry "accentEntry"
    wordDlgWordEntry `on` editableChanged $ (onWordEntryChanged wordDlgWordEntry wordDlgAccentEntry dict)
    
    inputText <- builderGetObject builder castToTextView  "inputText"
    descriptionText <- builderGetObject builder castToTextView  "descriptionText"       
    inputBuffer <- textViewGetBuffer inputText
    descriptionBuffer <- textViewGetBuffer descriptionText
    inputBuffer `on` bufferChanged $ (onInputChanged inputBuffer descriptionBuffer dict)
    widgetModifyBase descriptionText StateNormal (Color 55000 55000 55000)
            
    [newFileMenu,openFileMenu,saveFileMenu,saveAsFileMenu,quitMenu] <-
        mapM (builderGetObject builder castToImageMenuItem)
        ["newfilemenuitem","openfilemenuitem","savefilemenuitem","saveasfilemenuitem","quitmenuitem"]

    newFileMenu `on` menuItemActivate $ (onNewFileMenu inputBuffer)
    openFileMenu `on` menuItemActivate $ (onOpenFileMenu inputBuffer currFileName)
    saveFileMenu `on` menuItemActivate $ (onSaveFileMenu inputBuffer currFileName)
    saveAsFileMenu `on` menuItemActivate $ (onSaveAsFileMenu inputBuffer currFileName)
    quitMenu `on` menuItemActivate $ mainQuit
        
    [cutMenu,copyMenu,pasteMenu] <-
        mapM (builderGetObject builder castToImageMenuItem)
        ["cutmenuitem","copymenuitem","pastemenuitem"]
              
    cutMenu `on` menuItemActivate $ (onCutMenu inputBuffer) 
    copyMenu `on` menuItemActivate $ (onCopyMenu inputBuffer) 
    pasteMenu `on` menuItemActivate $ (onPasteMenu inputBuffer) 

    wordMenu <- builderGetObject builder castToMenuItem "wordmenuitem"
    wordMenu `on` menuItemActivate $ (onWordMenu wordDlg wordDlgWordEntry wordDlgAccentEntry inputBuffer dict)
    
    aboutMenu <- builderGetObject builder castToMenuItem "aboutmenuitem"
    aboutMenu `on` menuItemActivate $ about
    
    widgetShowAll window
    mainGUI
    
    writeDict dict "dict.txt" 
    
    zipDict "dict.txt"
    
    removeFile "dict.txt"

onInputChanged :: TextBuffer -> TextBuffer -> IORef WordDict -> IO ()
onInputChanged inBuf outBuf rdict = do 
    dict <- readIORef rdict
    (st,en) <- textBufferGetBounds inBuf
    text <- textBufferGetText inBuf st en True
    textBufferSetText outBuf $ T.unpack $ calcStatictics (T.pack text) dict
    return ()

onWordEntryChanged :: Entry -> Entry -> IORef WordDict -> IO ()
onWordEntryChanged wordEntry accentEntry rdict = do
    dict <- readIORef rdict
    word <- entryGetText wordEntry
    let sword = T.pack word
        accent = Map.lookup sword dict
    if (isJust accent) 
        then entrySetText accentEntry (showAccents $ fromJust accent)
        else entrySetText accentEntry ""


onWordMenu :: Dialog-> Entry -> Entry-> TextBuffer -> IORef WordDict -> IO ()
onWordMenu dlg wordEntry accentEntry inBuf rdict = do
    dict <- readIORef rdict
    (st,en) <- textBufferGetSelectionBounds inBuf
    text <- textBufferGetText inBuf st en True 
    entrySetText wordEntry text
    response <- dialogRun dlg
    widgetHide dlg
    if response == (ResponseUser 1) 
        then do
            wordText <- entryGetText wordEntry
            accentsText <- entryGetText accentEntry
            writeIORef rdict (populateDict dict wordText accentsText)
        else return ()

  
onCutMenu :: TextBuffer -> IO ()
onCutMenu inBuf = do 
    clipboard <- clipboardGet selectionClipboard    
    textBufferCutClipboard inBuf clipboard True
  
onCopyMenu :: TextBuffer -> IO ()
onCopyMenu inBuf = do 
    clipboard <- clipboardGet selectionClipboard    
    textBufferCopyClipboard inBuf clipboard  

onPasteMenu :: TextBuffer -> IO ()
onPasteMenu inBuf = do 
    clipboard <- clipboardGet selectionClipboard    
    textBufferPasteClipboardAtCursor inBuf clipboard True   

onNewFileMenu :: TextBuffer -> IO ()
onNewFileMenu inBuf = do
    textBufferSetText inBuf ""
    
onOpenFileMenu :: TextBuffer -> IORef String -> IO ()
onOpenFileMenu inBuf fileRef = do
    fcd <- fileChooserDialogNew Nothing Nothing FileChooserActionOpen [("OK", ResponseOk), ("Cancel", ResponseCancel)]
    res <- dialogRun fcd
    case res of
        ResponseOk -> do
            filename <- fileChooserGetFilename fcd 
            case filename of 
                Nothing -> return () 
                Just filename -> do
                    inh <- openFile filename ReadMode
                    inputData <- hGetContents inh
                    textBufferSetText inBuf inputData
                    hClose inh
                    writeIORef fileRef filename
        _ -> return()
    widgetDestroy fcd    
    
onSaveFileMenu :: TextBuffer -> IORef String -> IO ()
onSaveFileMenu inBuf fileRef = do
    currFileName <- readIORef fileRef
    case currFileName of
        [] -> do
            onSaveAsFileMenu inBuf fileRef
        filename -> do
           outh <- openFile filename WriteMode
           (st,en) <- textBufferGetBounds inBuf
           text <- textBufferGetText inBuf st en True
           hPutStrLn outh text
           hClose outh
           writeIORef fileRef filename 
    
onSaveAsFileMenu :: TextBuffer -> IORef String -> IO ()
onSaveAsFileMenu inBuf fileRef = do
    fcd <- fileChooserDialogNew Nothing Nothing FileChooserActionSave [("OK", ResponseOk), ("Cancel", ResponseCancel)]
    res <- dialogRun fcd
    case res of
        ResponseOk -> do
            filename <- fileChooserGetFilename fcd 
            case filename of 
                Nothing -> return () 
                Just filename -> do
                    outh <- openFile filename WriteMode
                    (st,en) <- textBufferGetBounds inBuf
                    text <- textBufferGetText inBuf st en True
                    hPutStrLn outh text
                    hClose outh
                    writeIORef fileRef filename
        _ -> return()
    widgetDestroy fcd    
    
about :: IO ()
about = do
    ad <- aboutDialogNew   
    set ad [aboutDialogProgramName := "Помощник поэта", 
            aboutDialogVersion := "0.0.1",
            aboutDialogAuthors := ["Kirill Kolodiazhnyi","<kolodyazhniy.kirill@gmail.com>"],
            aboutDialogWebsite := "http://code.google.com/p/poet-helper/",
            aboutDialogLogoIconName:= Just "pencil.ico"]
    
    dialogRun ad
    widgetDestroy ad          
                         
